OLIST06：時空間的視覺化工具

---

研究議題：各州之間的物流

載入套件與圖資

pacman::p_load(
  d3heatmap,rgeos,sp,stringr,readxl,dplyr,
  leaflet,leaflet.minicharts)
load("data/olist.rdata")

# Brazil Geo-Spatial Data
B <- read_excel("data/BR.xlsx")
B$GDP = B$GDP %>% 
  str_remove(",") %>% str_extract("^[0-9\\.]+") %>% as.numeric

G = readRDS("data/gadm36_BRA_1_sp.rds")
B = cbind(B, sapply(1:27, function(i) gCentroid(G[i,])@coords) %>% t)
names(B)[11:12] = c('lng','lat')
B$lat[24] = B$lat[24] - 1
B$lng[24] = B$lng[24] + 1

# leaflet world map url
tilesURL <- "http://server.arcgisonline.com/ArcGIS/rest/services/Canvas/World_Light_Gray_Base/MapServer/tile/{z}/{y}/{x}"

匯入顧客與廠商的位置

O2 = left_join(I[,c(1,4)], S[,c(1,4)]) %>% 
  right_join(O) %>% 
  left_join(C[,c(1,5)]) %>% 
  rename(from=seller_state, to=customer_state)

---

各州的貨物統計

計算各州的自用、輸出、輸入數量

df = sapply(unique(O2$to), function(s) c(
  Intra = sum(s == O2$from & s == O2$to, na.rm=T),
  Import = sum(s != O2$from & s == O2$to, na.rm=T),
  Export = sum(s == O2$from & s != O2$to, na.rm=T)
  )) %>% t %>% data.frame %>% 
  mutate(
    total = Intra + Import + Export,
    stCode = unique(O2$to)) %>% 
  left_join(B[,c(2,11,12)]) %>% data.frame

以圓餅圖比較各州的物流型態

leaflet(width = "100%", height = "800px") %>%  addTiles(tilesURL) %>% 
  addPolylines(data=G, color="darkcyan", weight=1, fillOpacity=0) %>% 
  addMinicharts(
    df$lng, df$lat, type = "pie",
    chartdata = df[,c("Intra","Import","Export")], 
    colorPalette = c("gold", "red", "seagreen"), 
    width = 80 * sqrt(df$total) / sqrt(max(df$total))
    )

---

東南10省與聖保羅(SP)

s10 = c("MG","PR","RJ","RS","SC","SP","DF","GO","ES","MS")
i10 = which(str_remove(G$HASC_1,"BR\\.") %in% s10)
df10 = subset(df, stCode %in% s10)

mx = xtabs(~from+to, subset(O2, from%in%s10 & to%in%s10)); mx

    to
from    DF    ES    GO    MG    MS    PR    RJ    RS    SC    SP
  DF    61    22    37   108     8    33   110    23    26   336
  ES     1     9     3    52     0    16    74    21    14   119
  GO    30     5    39   100     9    16    62    14    11   141
  MG   221   206   173  1709    71   415  1329   315   288  2964
  MS     4     0     1     4     0     4     9     1     1    19
  PR   178   117    94   938    66   827  1147   696   451  3410
  RJ   114   111   127   622    43   234  1122   227   138  1518
  RS    50    29    26   219    17   149   267   327   131   762
  SC    75    54    77   483    31   324   540   331   311  1506
  SP  1599  1647  1701  8703   561  3667  9688  4194  2749 36192

東南10省的物流佔全國的86%

sum(mx)/nrow(O2)

[1] 0.86246

聖保羅(SP)的物流佔全國的81%

mean(O2$from=="SP" | O2$to=="SP", na.rm=T)

[1] 0.81374

---

聖保羅的物流

df10 = df10 %>% mutate(
  lngSP= B$lng[B$stCode == "SP"],
  latSP = B$lat[B$stCode == "SP"]) %>% 
  arrange(stCode)
df10$fromSP = mx["SP",]
df10$toSP = mx[,"SP"]

聖保羅的輸出

leaflet(width = "100%", height = "800px") %>% addTiles(tilesURL) %>% 
  addPolylines(data=G[i10,], color="gray", weight=2, fillOpacity=0) %>% 
  addFlows(
    df10$lngSP, df10$latSP, df10$lng, df10$lat, flow=df10$fromSP,
    color = "green", opacity = 0.4, maxThickness = 40) %>% 
  addMinicharts(
    df10$lng, df10$lat, type = "pie",
    chartdata = df10[,c("Intra","Import","Export")], 
    colorPalette = c("gold", "red", "seagreen"), 
    width = 80 * sqrt(df10$total) / sqrt(max(df10$total))
    )

聖保羅的輸入

leaflet(width = "100%", height = "800px") %>% addTiles(tilesURL) %>% 
  addPolylines(data=G[i10,], color="gray", weight=2, fillOpacity=0) %>% 
  addFlows(
    df10$lng, df10$lat, df10$lngSP, df10$latSP, flow=df10$toSP,
    color = "red", opacity = 0.3, maxThickness = 60) %>% 
  addMinicharts(
    df10$lng, df10$lat, type = "pie",
    chartdata = df10[,c("Intra","Import","Export")], 
    colorPalette = c("gold", "red", "seagreen"), 
    width = 80 * sqrt(df10$total) / sqrt(max(df10$total))
    )

---

時間面板與時空間整合

選擇時間範圍

O2$month = format(O2$order_delivered_customer_date, "%Y-%m")
table(O2$month)[6:23]

2017-03 2017-04 2017-05 2017-06 2017-07 2017-08 2017-09 2017-10 2017-11 2017-12 
   2724    2072    4201    3640    3933    4900    4496    5215    5412    8319 
2018-01 2018-02 2018-03 2018-04 2018-05 2018-06 2018-07 2018-08 
   7419    6623    7948    8999    8166    7887    6581    9385 

製作時間面板

dx = do.call(rbind, lapply(names(table(O2$month))[6:23], function(m) {
  df = df10 
  or = subset(O2, month == m & (from%in%s10 | to%in%s10) )
  or = or %>% mutate_at(vars(from,to), factor, levels=sort(s10))
  mx = xtabs(~from+to, or)
  df$Intra = diag(mx)
  df$Import = colSums(mx) - diag(mx)
  df$Export = rowSums(mx) - diag(mx)
  df$total = df$Intra + df$Import + df$Export
  df$fromSP = mx["SP",]
  df$toSP = mx[,"SP"]
  df$month = m
  df
  }))

聖保羅的輸出，2017-03~2018-08

leaflet(width = "100%", height = "800px") %>% addTiles(tilesURL) %>% 
  addPolylines(data=G[i10,], color="gray", weight=2, fillOpacity=0) %>% 
  addFlows(
    dx$lngSP, dx$latSP, dx$lng, dx$lat, flow=dx$fromSP,
    color = "green", opacity = 0.4, maxThickness = 60, time = dx$month) %>% 
  addMinicharts(
    dx$lng, dx$lat, type = "pie", time = dx$month,
    chartdata = dx[,c("Intra","Import","Export")],
    colorPalette = c("gold", "red", "seagreen"),
    width = 100 * sqrt(dx$total) / sqrt(max(dx$total))
    )

---